home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
TPFORT18.ARJ
/
CALLFORT.ASM
next >
Wrap
Assembly Source File
|
1992-02-05
|
3KB
|
107 lines
; TPFORT v 1.8
; Externals for FORTLINK unit
data segment word public
extrn procs:dword,numprocs:word
extrn FortDS:word, FortSP:word
data ends
code segment byte public
public SaveTPDS,callfort,fdouble,fsingle,fpointer,enter_pascal
TPDS dw ? ; TPDS must be set during initialization
SaveTPDS proc near
cs: mov TPDS,DS
ret
Initcall macro ; gets addresses in BX and BP
add sp,4 ; get rid of return to Pascal stub
pop cx ; get procedure number
mov sp,bp ; get rid of any locals
dec cx
shl cx,1
shl cx,1
mov bx,offset procs
add bx,cx ; BX = offset in proc table (in TP DS)
shl cx,1
mov bp,Fortsp
add bp,cx ; BP = offset in context table (in SS)
pop ax ; keep saved BP in AX for now
pop di ; save return offset of original caller
pop si ; save return segment of original caller
#EM
PushResult macro ; Pushes 16 bit address on stack where
; function result should go
push bp ; push result address
#EM
Makecall macro ; Restore BP, find Fortran address in Procs table,
; set Fortran DS, and call it
mov bp,ax
push ds
pop es
mov ds,FortDS
es: call far d[bx]
#EM
Exitcall macro ; Restore TP DS, BP, and return to original caller
cs: mov ds,TPDS
push si ; Push back return segment
push di ; and offset
retf ; returns directly to original caller
#EM
callfort proc far
Initcall
Makecall
Exitcall
endp
fdouble proc far
Initcall
PushResult
Makecall
mov ds,dx
mov bx,ax
fld q[bx] ; load function result
Exitcall
endp
fsingle proc far
Initcall
PushResult
Makecall
mov ds,dx
mov bx,ax
fld d[bx] ; load function result
Exitcall
endp
fpointer proc far
Initcall
PushResult
Makecall
Exitcall
endp
enter_pascal proc far
pop ax ; get our return address
pop bx
pushf ; save the flags, DS, SI, and DI
push ds
push si
push di
cs: mov ds,TPDS ; load the TP data segment
push bx ; put back our return address
push ax
retf
endp